home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
PRUS101
/
FTMODE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-07-20
|
19KB
|
637 lines
Unit FTMode; { FIDO unit for handling of 'weird' text modes }
(***************************************************************************
RELEASE 1.03 - as contained in the file PRUS100.LZH
by Max Maischein, 2:244/1106.17, GERMANY
--------------------------------------------
organized for Fido's PASCAL related echoes
--------------------------------------------
05/18/1994 to 05/21/1994 by Orazio Czerwenka, 2:2450/540.55, GERMANY
05/22/1994 to --/--/---- by Max Maischein, 2:244/1106.17, GERMANY
As far as third party copyrights are not violated this
source code is hereby placed to the public domain. Use
it whatever way you want, but use AT YOUR OWN RISK.
In case you should modify the source rather send your
modifications to the unit's current organizer (see above for
NM address) than to spread it on your own. This will help to
keep the unit updated and grant a certain standard to all
other users as well.
The unit is currently still under work. So it might greatly
benefit of your participation.
Those who contributed to the following piece of source,
listed in alphabethical order:
================================================================
Martin Austermeier (as credited in ZEILEN.PAS), Orazio
Czerwenka, Richard Kitson, Olaf Kummer (EMODE.PAS, c't
09/91), Wilbert van Leijen (VGA90.ASM), Max Maischein (Unit
EMODE.PAS), Bernhard Steffen (80x33 Mode), Wolfgang Wichern
(ZEILEN.PAS) ...
================================================================
YOUR NAME WILL APPEAR HERE IF YOU CONTRIBUTE USEFUL SOURCE.
This unit basically is based upon Max Maischein's PD-Unit
EMODE.PAS.
Credits in your own programs are owed to Max Maischein as
demanded in his Unit EMODE.PAS and to the German 'techie
journal' c't.
***************************************************************************)
{$I FDEFINE.DEF}
Interface
Uses
DOS
{$IFDEF DPMI}
,WinAPI
,fDPMI
{$ENDIF}
{$IFDEF CRT} ,CRT {$ENDIF}
{$IFDEF FCRT} ,FCRT {$ENDIF}
{$IFDEF CRT2} ,CRT2 {$ENDIF}
;
Const
ftmOK = 0;
ftmUnsupportedLines = 1;
ftmUnsupportedColumns = 2;
FTMError : Integer = ftmOK;
{ this integer will hold the status of the last mode set }
KnownColumns = [40,80,90,94];
KnownLines = [12,14,21,25,28,30,33,34,40,43,50,60];
{ ************************************************************************** }
{ these are constants to switch to the enhanced text modes provided via
the unit FTMODE by simply using an enhanced TEXTMODE routine.
NOTICE that most of these enhanced modes will run only on VGA systems.
Some of'em won't display correctly in 90 column mode when used with
older displays. Some others might well be run also on EGA systems, but
for we have not tested this so far, there is no validity checking
implemented for different card settings. You have to find out yourself.
Please report your results to the current 'unit's organizer' of the unit
FTMODE. }
Co40x12 = 12 SHL 8 + 40; Co80x12 = 12 SHL 8 + 80;
Co40x14 = 14 SHL 8 + 40; Co80x14 = 14 SHL 8 + 80;
Co40x21 = 21 SHL 8 + 40; Co80x21 = 21 SHL 8 + 80;
Co40x25 = 25 SHL 8 + 40; Co80x25 = 25 SHL 8 + 80;
Co40x28 = 28 SHL 8 + 40; Co80x28 = 28 SHL 8 + 80;
Co40x30 = 30 SHL 8 + 40; Co80x30 = 30 SHL 8 + 80;
Co40x33 = 33 SHL 8 + 40; Co80x33 = 33 SHL 8 + 80;
Co40x34 = 34 SHL 8 + 40; Co80x34 = 34 SHL 8 + 80;
Co40x40 = 40 SHL 8 + 40; Co80x40 = 40 SHL 8 + 80;
Co40x43 = 43 SHL 8 + 40; Co80x43 = 43 SHL 8 + 80;
Co40x50 = 50 SHL 8 + 40; Co80x50 = 50 SHL 8 + 80;
Co40x60 = 60 SHL 8 + 40; Co80x60 = 60 SHL 8 + 80;
Co90x12 = 12 SHL 8 + 90; Co94x12 = 12 SHL 8 + 94;
Co90x14 = 14 SHL 8 + 90; Co94x14 = 14 SHL 8 + 94;
Co90x21 = 21 SHL 8 + 90; Co94x21 = 21 SHL 8 + 94;
Co90x25 = 25 SHL 8 + 90; Co94x25 = 25 SHL 8 + 94;
Co90x28 = 28 SHL 8 + 90; Co94x28 = 28 SHL 8 + 94;
Co90x30 = 30 SHL 8 + 90; Co94x30 = 30 SHL 8 + 94;
Co90x33 = 33 SHL 8 + 90; Co94x33 = 33 SHL 8 + 94;
Co90x34 = 34 SHL 8 + 90; Co94x34 = 34 SHL 8 + 94;
Co90x40 = 40 SHL 8 + 90; Co94x40 = 40 SHL 8 + 94;
Co90x43 = 43 SHL 8 + 90; Co94x43 = 43 SHL 8 + 94;
Co90x50 = 50 SHL 8 + 90; Co94x50 = 50 SHL 8 + 94;
Co90x60 = 60 SHL 8 + 90; Co94x60 = 60 SHL 8 + 94;
{ the following constants are intended to provide CRT TEXTMODE
compatibility }
BW40 = 0; Co40 = 1;
BW80 = 2; Co80 = 3;
Mono = 7; Font8x8 = 256;
C40 = Co40; C80 = Co80;
{ ************************************************************************** }
VAR DisplayMode : Byte Absolute $40:$49;
DisplayCols : Word absolute $40:$4A;
EGADisplayRows : Byte Absolute $40:$84;
{$IFnDEF FCRT}
RegenBufLen : Word Absolute $40:$4C;
{$ENDIF}
CharScanLines : Byte absolute $40:$85;
{$IFDEF FCRT}
procedure TextMode(Mode: WORD);
{$ENDIF}
Procedure SetVGAMode( Cols, Lines : Byte );
(* Sets a video mode with the specified number of columns and lines *)
(* If one of them is zero, the current value will remain unchanged *)
Procedure VGAFontHeight( Size : Byte );
Procedure Load8x8;
Inline(
$B8/$02/$11 { MOV AX,1102 }
/$30/$DB { XOR BL,BL }
/$CD/$10 { INT 10 }
);
Procedure Load14x8;
Inline(
$B8/$01/$11 { MOV AX,1101 }
/$30/$DB { XOR BL,BL }
/$CD/$10 { INT 10 }
);
Procedure Load16x8;
Inline(
$B8/$04/$11 { MOV AX,1104 }
/$30/$DB { XOR BL,BL }
/$CD/$10 { INT 10 }
);
Procedure Set200ScanLines;
Inline(
$B8/$00/$12 { MOV AX,1200 }
/$B3/$30 { MOV BL,30 }
/$CD/$10 { INT 10 }
);
Procedure Set350ScanLines;
Inline(
$B8/$01/$12 { MOV AX,1201 }
/$B3/$30 { MOV BL,30 }
/$CD/$10 { INT 10 }
);
Procedure Set400ScanLines;
Inline(
$B8/$02/$12 { MOV AX,1202 }
/$B3/$30 { MOV BL,30 }
/$CD/$10 { INT 10 }
);
Procedure Set480Scanlines;
Implementation
{$IFDEF CRT}
{$IFnDEF FCRT}
Procedure SetVideoMode( VideoMode : Word ); forward;
{$ENDIF}
{$ENDIF}
Procedure VGAOn;
Assembler;
Asm
mov dx, 03D4h
mov al, 17
out dx, al
inc dx
in al, dx
or al, 80h
out dx, al
dec dx { dx = 03D4h }
mov al, 23 {CRTC-Reset freigeben}
out dx, al
inc dx
in al, dx
or al, 80h
out dx, al
sub dl, 11h { dx = 03C4h }
mov ax, 0300h {Sequenzer einschalten}
out dx, ax
sti
End;
Procedure VGAOff;
Assembler;
Asm
cli
mov dx, 03C4h
mov ax, 0100h {Sequenzer ausschalten}
out dx, ax
add dl, 10h { dx = 03D4h }
mov al, 23 {CRTC-Reset setzen}
out dx, al
inc dx
in al, dx
and al, 07Fh
out dx, al
dec dx
mov al, 17 {CRTC-Register 0-7 freigeben}
out dx, al
inc dx
in al, dx
and al, 07Fh
out dx, al
End;
Const CRTCTableSize = 9;
{$IFnDEF UseBIOS}
Const VGA80ColData : Array[ 0..Pred( CRTCTableSize )] of Word = (
$5F00, { horizontal total = 95 columns }
$4F01, { displayed total = 80 - 1 columns }
$5002, { start horiz blanking = column 80 }
$8203, { end blanking set }
$5504, { start horizontal retrace set }
$8105, { end retrace set }
$2813, { Logical Line Width (80/2)}
{ -- }
$0001, { 8-PEL Chars }
{--}
$0800 { PEL pan }
);
{$ENDIF}
Const VGA90ColData : Array[ 0..Pred( CRTCTableSize )] of Word = (
$6B00, { horizontal total-5 }
$5901, { displayed total = 90 - 1 columns }
$5A02, { start horiz blanking = column 90 }
$8E03, { end blanking set }
$6004, { start retrace set }
$8D05, { end retrace set }
$2D13, { Logical Line Width (90/2)}
{ -- }
$0101, { 8-PEL Chars }
{ -- }
$0800 { PEL pan }
);
Const VGA94ColData : Array[ 0..Pred( CRTCTableSize )] of Word = (
$6C00, { Horizontal Total-5}
$5D01, { Hor. Display Enable End - 1}
$5E02, { Start Horizontal Blanking}
$8F03, { End Horizontal Blanking}
$6204, { Start Horizontal Retrace}
$8E05, { End Horizont2al Retrace}
$2F13, { Logical Line Width (94/2)}
{ -- }
$0101, { 8-PEL Chars }
{ -- }
$0000 { PEL pan }
);
Const VGA480Entries = 8;
VGA480SLinesTable : Array[ 0..Pred(VGA480Entries )] of Word = (
$0B06, {Vertical Total}
$3E07, {CRT Overflow}
$4F09, {Maximum Scan Line}
$EA10, {Start Vertical Retrace}
$8C11, {End Vertical Retrace}
$DF12, {Vert. Display Enable End}
$E715, {Start Vertical Blanking}
$0416
);
Procedure UpdateCRTCData;
Assembler;
(* ds:si -> New sequencer register table *)
Asm
cld
mov dx, 03D4h
mov cx, CRTCTableSize-2
rep outsw
mov dx, 03C4h { set 8/9 PEL wide
chars }
outsw
lodsw { update PEL panning
register }
mov dx, 03DAh { dummy read to reset
flip-flop }
in al, dx
mov dx, 03C0h { Horizontal PEL
Panning }
mov al, $13 { PEL Panning }
out dx, al
mov al, ah
out dx, al
mov al, 20h { ???? }
out dx, al
out dx, al
End;
Procedure VGA94Columns;
Assembler;
Asm
mov dx, 03CCh
in al, dx
and al, 0F3h
or al, 4
sub dx, 0Ah { dx = 03C2h }
out dx, al { 720 PEL wählen}
mov si, offset VGA94ColData
call UpdateCRTCData { dx = 03D4h }
End;
Procedure VGA90Columns;
Assembler;
Asm
mov si, offset VGA90ColData
call UpdateCRTCData
End;
{$IFnDEF UseBIOS}
Procedure VGA80Columns; Assembler;
Asm
mov si, offset VGA80ColData
call UpdateCRTCData
End;
{$ENDIF}
Procedure VGA33Zeilen;
Type
TVGA8x14 = Array[ Char, 0..13] of Byte;
TVGA8x12 = Array[ Char, 0..11] of Byte;
PVGA8x12 = ^TVGA8x12;
PVGA8x14 = ^TVGA8x14;
Var Font8x12 : TVGA8x12; { Memory allocated on stack !!! }
Font8x14 : TVGA8x14;
Procedure GetFont8x14;
Var
{$IFDEF DPMI}
Regs : TRealModeRegs;
{$ELSE}
Regs : Registers;
{$ENDIF}
Begin
{$IFDEF DPMI}
FillChar( Regs, SizeOf( Regs ), 0 );
{$ENDIF}
Regs.AX := $1130;
Regs.BH := 2;
{$IFDEF DPMI}
RealModeInt( $10, Regs );
Regs.ES := NewSelector( Regs.ES*LongInt( 16 ), $FFFF );
{$ELSE}
Intr ($10,Regs);
{$ENDIF}
Font8x14 := PVGA8x14( Ptr( Regs.ES,Regs.BP ))^;
{$IFDEF DPMI}
FreeSelector( Regs.ES );
{$ENDIF}
End;
Procedure SetUserFont (Lines : BYTE; Data : TVGA8x12);
Var
{$IFDEF DPMI}
Regs : TRealModeRegs;
LowMemoryData : Pointer;
LowMemorySeg : Word;
{$ELSE}
Regs : Registers;
{$ENDIF}
Begin
{$IFDEF DPMI}
FillChar( Regs, SizeOf( Regs ), 0 );
{$ENDIF}
Regs.ax := $1110;
Regs.bh := Lines;
Regs.bl := 0;
Regs.cx := 256;
Regs.dx := 0;
{$IFDEF DPMI}
Regs.ES := AllocateLowMem( SizeOf( Data ), LowMemoryData );
Regs.BP := 0;
Move( Data, LowMemoryData^, SizeOf( Data ));
FillChar( LowMemoryData^, SizeOf( LowMemoryData^ ), 0 );
RealModeInt( $10, Regs );
FreeLowMem( LowMemoryData );
{$ELSE}
Regs.es := seg( Data );
Regs.bp := ofs( Data );
Intr($10,regs);
{$ENDIF}
End;
Var Ch : Char ;
Begin
{ 8x14-Font auslesen }
GetFont8x14;
{ Rasterzeilen 2 bis 13 kopieren }
For Ch := #0 to #255 do
Move(Font8x14[ Ch, 1 ],Font8x12[ Ch, 0 ],12 );
{ neuen 8x12-Font setzen }
SetUserFont(12, Font8x12 );
End;
Procedure Set480Scanlines;
Assembler;
Asm
mov dx, 03CCh
in al, dx
or al, 192
sub dx, 0Ah { dx = 03C2h }
out dx, al { Sync-Polarität setzen}
cld
add dx, 012h { dx = 03D4h }
mov si, offset VGA480SLinesTable
mov cx, VGA480Entries
rep outsw
End;
Procedure VGAFontHeight( Size : Byte );
{ Updates the BIOS data area }
Begin
Mem[0:$485] := Size; {BIOS informieren}
Port[$3D4] := 9; {Maximum Scan Line}
Port[$3D5] := (Port[$3D5] and $E0) + Size - 1;
Port[$3D4] := 10; {Cursor Start}
If Size <= 12 then Port[$3D5] := Size - 2 else Port[$3D5] := Size - 3;
Port[$3D4] := 11; {Cursor End}
If Size <= 12 then Port[$3D5] := Size - 1 else Port[$3D5] := Size - 2;
End;
Procedure SetVGAMode( Cols, Lines : Byte );
Var SLines : Byte;
Force80Columns : Boolean;
ChangeColumns, ChangeLines : Boolean;
Begin
ChangeColumns := Cols <> 0;
ChangeLines := Lines <> 0;
If ChangeColumns and not ( Cols in KnownColumns )
then ftmError := ftmUnsupportedColumns;
If ChangeLines and not ( Lines in KnownLines )
then ftmError := ftmUnsupportedLines;
If ftmError <> ftmOK
then Exit;
{ Check for invalid line specification and set scan lines }
{ ------------------------------------------------------- }
Case Lines of
12, 14 : Set200ScanLines;
21, 43 : Set350ScanLines;
25, 28, 30, 33, 34, 40, 50, 60 : Set400ScanLines;
End; { of Case Lines of }
{ set VideoMode }
{ ------------- }
Case Cols of
40 : SetVideoMode( 1 );
80, 90, 94 : SetVideoMode( 3 );
End;
{$IFnDEF UseBIOS}
Force80Columns := DisplayCols <> 80;
{$ENDIF}
{ Load the equivalent BIOS font }
{ ----------------------------- }
Case Lines of
12, 21, 25, 30 : Begin Load16x8; SLines := 16; End;
14, 28, 34 : Begin Load14x8; SLines := 14; End;
33, 40 : Begin VGA33Zeilen; SLines := 12; End;
43, 50, 60 : Begin Load8x8; SLines := 8; End;
End; { of Case Lines }
If ( Cols in [90,94] ) or ( Lines in [30,34,40,60] )
{$IFnDEF UseBIOS} or Force80Columns {$ENDIF}
then
Begin
VGAOff;
{$IFnDEF UseBIOS}
If Cols = 80
then VGA80Columns
else
{$ENDIF}
If Cols = 90
then VGA90Columns
else
If Cols = 94
then VGA94Columns;
If Lines in [30,34,40,60]
then Set480ScanLines;
VGAOn;
End;
{ Tell the VGA, the BIOS and FCRT what's going on }
{ If FCRT is linked call ReInitFCRT }
{ If CRT is linked, update WindMax }
VGAFontHeight( SLines );
If ChangeColumns
then DisplayCols := Cols;
If ChangeLines
then EGADisplayRows:= Pred( Lines );
{$IFnDEF FCRT}
RegenBufLen := ( DisplayCols * ( EGADisplayRows +1 )) * 2;
{$ELSE}
VideoPageSize := ( DisplayCols * ( EGADisplayRows +1 )) * 2;
{$ENDIF}
{ if necessary, update the local control variables of those units : }
{$IFDEF FCRT}
{
MaxX := DisplayCols;
MaxY := EGADisplayRows;
If VGACard then Inc(MaxY);
}
ReInitFCRT;
{$ENDIF}
{$IFDEF CRT}
WindMax := DisplayCols + EGADisplayRows *256;
{$ENDIF}
End;
{ ************************************************************************** }
{$IFDEF FCRT}
procedure TextMode(Mode:WORD);
{ Original author: Orazio Czerwenka }
var
x,y : Byte;
procedure UpdateBiosMem;
var
LoMode : word absolute $40:$4A;
HiMode : word absolute $40:$84;
MoSize : word absolute $40:$4C;
begin
LoMode := 80;
if EGAAvail then begin
if VGAAvail then begin
HiMode := 49;
MoSize := 80*50*2;
end
else begin
HiMode := 42;
MoSize := 80*43*2;
end;
end
else begin
HiMode := 24;
MoSize := 80*25*2;
end;
end;
begin
CASE Mode of
0..7: SetVideoMode(Mode);
256..263: Begin
if EGAAvail then begin
if VGAAvail
then Set400ScanLines
else Set350ScanLines;
SetVideoMode(Mode-font8x8);
Load8x8;
VGAFontHeight(8);
end
else SetVideoMode(Mode);
UpdateBiosMem;
ReInitFCRT;
END; { begin }
else begin
x:= Lo(Mode); y:= Hi(Mode);
if VGAAvail then SetVGAMode(x,y) else begin
{ here will be implemented support for other
graphics adapters in future releases }
end;
end; { else }
end; { Case }
end;
{$ENDIF}
{ ************************************************************************** }
{$IFDEF CRT}
{$IFnDEF FCRT}
Procedure SetVideoMode;
Begin
VideoMode := VideoMode and $FF;
TextMode( VideoMode );
End;
{$ENDIF}
{$ENDIF}
End.